home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / oldwp / Menu / Window.PAS < prev   
Pascal/Delphi Source File  |  1995-01-03  |  8KB  |  284 lines
  1. (*
  2.  * A little routine to fill in the members of a NewMenu struct
  3.  *
  4.  * Cheat & use a bit of assembler to get direct access to the embedded
  5.  * string constants
  6.  *)
  7. procedure nm(var mnm: tNewMenu;
  8.     nmType: byte;
  9.     nmLabel: string;
  10.     nmCommKey: string;
  11.     nmFlags: word;
  12.     nmMutualExclude: longint;
  13.     nmUserData: LONG); assembler;
  14. asm
  15.     move.l    mnm,a0                                    { address of the element }
  16.     move.b    nmType,tNewMenu.nm_Type(a0)                        { copy the type }
  17.  
  18.     move.l    nmLabel,a1                      { the address of the Pascal string }
  19.     tst.b    (a1)+                     { check for zero length & skip length byte }
  20.     bne        @1                                      { if not zero, nothing to do }
  21.     move.l    #NM_BARLABEL,a1              { substitute empty strings with a bar }
  22. @1:    move.l    a1,tNewMenu.nm_Label(a0)                    { store the C string }
  23.  
  24.     move.l    nmCommKey,a1                                { same for the CommKey }
  25.     tst.b    (a1)+
  26.     bne        @2
  27.     suba.l    a1,a1                                { use nil if the empty string }
  28. @2:    move.l    a1,tNewMenu.nm_CommKey(a0)
  29.                                                       { the remaining fields }
  30.     move.w    nmFlags,tNewMenu.nm_Flags(a0)
  31.     move.l    nmMutualExclude,tNewMenu.nm_MutualExclude(a0)
  32.     move.l    nmUserData,tNewMenu.nm_UserData(a0)
  33. end;
  34.  
  35.  
  36. Procedure InitMenus(w : pWindow);
  37.  
  38. Var
  39.     T              : Array[0..2] Of LONG;
  40.     mm             : Array[0..7] of tNewMenu;
  41.    
  42. Begin
  43.     nm(mm[0], NM_TITLE, 'Project'#0, '', 0, 0, 0);
  44.     nm(mm[1], NM_ITEM , 'Preferences...'#0, 'P'#0, 0, 0, M_PREF);
  45.     nm(mm[2], NM_ITEM , 'About...'#0, '?'#0, 0, 0, M_ABOUT);
  46.     nm(mm[3], NM_ITEM , '', '', 0, 0, 0);
  47.     nm(mm[4], NM_ITEM , 'Hide'#0, 'H'#0, 0, 0, M_HIDE);
  48.     nm(mm[5], NM_ITEM , '', '', 0, 0, 0);
  49.     nm(mm[6], NM_ITEM , 'Quit'#0, 'Q'#0, 0, 0, M_QUIT);
  50.     nm(mm[7], NM_END  , '', '', 0, 0, 0);
  51.  
  52.     menustrip := CreateMenusA(@mm, NIL);
  53.     if menustrip <> NIL then begin
  54.         T[0] := GTMN_NewLookMenus;
  55.         T[1] := True_;
  56.         T[2] := TAG_END;
  57.         if LayoutMenusA(menustrip,vi,@T) then
  58.             OK := SetMenuStrip(w,MenuStrip);
  59.     End;
  60. End;
  61.  
  62. Procedure FreeMenus(w : pWindow);
  63.  
  64. Begin
  65.     if opened then begin
  66.         {Writeln('* FreeMenus()');}
  67.         ClearMenuStrip(w);
  68.         Gadtools.FreeMenus(MenuStrip);
  69.     End;
  70. End;
  71.  
  72.  
  73. { add window to wb app. list }
  74. Function AddAppWin(VAR w : pWindow) : Boolean;
  75.  
  76. Begin
  77.     AddAppWin := False;
  78.     AppPort := CreateMsgPort;
  79.     if AppPort <> NIL then begin
  80.         aw := AddAppWindowA(0,0,w,AppPort,NIL);
  81.         { don't check, it fails if wb not running }
  82.         AddAppWin := True;
  83.     End; 
  84. End;
  85.  
  86. Procedure RemoveAppWin;
  87.  
  88. Var
  89.     Ok : Boolean;
  90.     m  : pMessage;
  91.     
  92. Begin
  93.     if opened then begin
  94.         {Writeln('* RemoveAppWin()');}
  95.  
  96.         if (AppPort <> NIL) then begin
  97.             m := GetMsg(AppPort);
  98.             While m <> NIL do begin
  99.                 ReplyMsg(m);
  100.                 m := GetMsg(AppPort);
  101.             End;
  102.         End;
  103.         if aw <> NIL then
  104.             Ok := RemoveAppWindow(aw);
  105.         if AppPort <> NIL then
  106.             DeleteMsgPort(AppPort);
  107.     End;
  108. End;
  109.  
  110. Function MakeLVGadget(prev : pGadget): pGadget;
  111.  
  112. Var
  113.     gadgetflags : tNewGadget;
  114.     t : Array[0..6] of LONG;
  115.     
  116. begin
  117.     T[0] := GTLV_ShowSelected;
  118.     T[1] := 0;
  119.     t[2] := GTLV_Labels;
  120.     t[3] := LONG(CurrentList);
  121.     t[4] := GTLV_ScrollWidth;
  122.     t[5] := CD.cd_SWid;
  123.     T[6] := TAG_END;
  124.     With GadgetFlags Do Begin
  125.         ng_TextAttr   := @CD.cd_Font;
  126.         ng_LeftEdge   := 8;
  127.         ng_TopEdge    := (S[TBS]+1);
  128.         
  129.         If CD.cd_Level = LEV_NOBOR then begin
  130.             ng_LeftEdge := 0;
  131.             ng_TopEdge  := 0;
  132.         End;
  133.         
  134.         If CD.cd_Level = LEV_NOBOR then
  135.             ng_Width    := CD.cd_Width
  136.         else
  137.             ng_Width    := CD.cd_Width-ng_LeftEdge*2;
  138.              
  139.         ng_VisualInfo := vi;
  140.         ng_Height     := CD.cd_Height-ng_TopEdge-13;
  141.         if GadToolsBase^.lib_Version < 39 then
  142.             ng_Height   := ng_Height - S[TBS];
  143.         If CD.cd_Level = LEV_BACKD then
  144.             ng_Height   := ng_Height + 13;
  145.             
  146.         If CD.cd_Level = LEV_NOBOR then
  147.             ng_Height   := CD.cd_Height + 4 - ((CD.cd_Height-4) mod ng_TextAttr^.ta_YSize);
  148.             
  149.         ng_GadgetText := NIL;
  150.         ng_GadgetID   := G_LV;
  151.         ng_Flags      := PLACETEXT_ABOVE|NG_HIGHLABEL;
  152.     End;
  153.     MakeLVGadget := CreateGadgetA(LISTVIEW_KIND, Prev, @Gadgetflags, @T);
  154.     LVRows := ((GadgetFlags.ng_Height-4) div CD.cd_Font.ta_YSize);
  155. End;
  156.  
  157. { open the main window }
  158. Function OpenTheWindow : pWindow;
  159.  
  160. Var 
  161.     T              : Array[0..15] Of tTagItem;
  162.     screendef      : pScreen;
  163.     TheWindow      : pWindow;
  164.    
  165. Begin
  166.     TheWindow := NIL;
  167.     G[G_NI]  := NIL;
  168.    
  169.   if PtrToPas(CD.cd_PubScreen) <> '' then
  170.         ScreenDef := LockPubScreen(CD.cd_PubScreen)
  171.     else
  172.         ScreenDef := LockPubScreen(NIL);
  173.     if Screendef = NIL then
  174.         ScreenDef := LockPubScreen(NIL);
  175.  
  176.     { Get visual info and create context }
  177.     vi := GetVisualInfoA(screendef, NIL);
  178.     If vi <> NIL Then begin
  179.         G[G_CC] := CreateContext(@G[G_NI]);
  180.         If G[G_CC] <> NIL Then begin
  181.             { Get some data from the screen }
  182.  
  183.             S[TBS]   := screendef^.WBorTop + (screendef^.Font^.ta_YSize + 1);
  184.             S[S_Gad_H] := 9+screendef^.WBorTop+1;
  185.    
  186.             G[G_LV] := MakeLVGadget(G[G_CC]);
  187.                                     
  188.             { window structure }
  189.             T[0].ti_Tag  := WA_Left;
  190.             T[0].ti_Data := CD.cd_LeftEdge;
  191.             T[1].ti_Tag  := WA_Top;
  192.             if CD.cd_TopEdge = -1 then
  193.                 T[1].ti_Data := S[TBS]
  194.             else
  195.                 T[1].ti_Data := CD.cd_TopEdge;
  196.             T[2].ti_Tag  := WA_Width;
  197.             T[2].ti_Data := CD.cd_Width;
  198.             T[3].ti_Tag  := WA_Height;
  199.             T[3].ti_Data := CD.cd_Height;
  200.             If CD.cd_Level = LEV_NOBOR then
  201.                 T[3].ti_Data := G[G_LV]^.Height; 
  202.             T[4].ti_Tag  := WA_Title;
  203.             T[4].ti_Data := LONG(CD.cd_WinTit);
  204.             If CD.cd_Level = LEV_NOBOR then
  205.                 T[4].ti_Tag:= TAG_IGNORE;
  206.             T[5].ti_Tag  := WA_IDCMP;
  207.             T[5].ti_Data := IDCMP_REFRESHWINDOW|BUTTONIDCMP|LISTVIEWIDCMP|
  208.                             IDCMP_MENUPICK|IDCMP_CLOSEWINDOW|IDCMP_NEWSIZE|
  209.                             IDCMP_CHANGEWINDOW|IDCMP_MENUPICK|IDCMP_VANILLAKEY;
  210.             
  211.             T[6].ti_Tag  := WA_Flags;
  212.             T[6].ti_Data := WFLG_SIMPLE_REFRESH|WFLG_NEWLOOKMENUS;
  213.             Case CD.cd_Level of
  214.                 LEV_BACKD : T[6].ti_Data := T[6].ti_Data|WFLG_CLOSEGADGET|WFLG_BACKDROP;
  215.               LEV_NOBOR : T[6].ti_Data := T[6].ti_Data|WFLG_BORDERLESS|WFLG_BACKDROP;
  216.               Else 
  217.                   T[6].ti_Data := T[6].ti_Data | WFLG_CLOSEGADGET|WFLG_DRAGBAR|
  218.                              WFLG_SIZEGADGET|WFLG_SIZEBBOTTOM|WFLG_DEPTHGADGET;
  219.             End; 
  220.                             
  221.             T[7].ti_Tag := WA_Gadgets;
  222.             T[7].ti_Data:= LONG(G[G_NI]);
  223.             T[8].ti_Tag  := WA_ScreenTitle;
  224.             T[8].ti_Data := LONG(CStrConstPtrAR(@prk, PtrToPas(CD.cd_ScrTit)+
  225.               '      Registered To : ' + Reg.key_User)); 
  226.             T[9].ti_Tag := WA_MinWidth;
  227.             T[9].ti_Data:= 80;
  228.             T[10].ti_Tag := WA_MinHeight;
  229.             T[10].ti_Data:= S[TBS]*4;
  230.             
  231.             T[11].ti_Tag := WA_MaxWidth;
  232.             T[11].ti_Data:= -1;
  233.             T[12].ti_Tag := WA_MaxHeight;
  234.             T[12].ti_Data:= -1;
  235.             if PtrToPas(CD.cd_PubScreen) <> '' then begin
  236.                 T[13].ti_Tag  := WA_PubScreenName;
  237.                 T[13].ti_Data := LONG(CD.cd_PubScreen);
  238.                 T[14].ti_Tag  := WA_PubScreenFallBack;
  239.                 T[14].ti_Data := True_;
  240.                 T[15].ti_Tag := TAG_DONE;
  241.             End else begin
  242.                 T[13].ti_Tag := TAG_DONE;
  243.             End;
  244.   
  245.             TheWindow := OpenWindowTaglist(NIL,@T);
  246.             If TheWindow <> NIL Then begin
  247.                 SetAPen(TheWindow^.RPort, 1);
  248.                 SetBPen(TheWindow^.RPort, 2);
  249.                 GT_RefreshWindow(TheWindow, NIL);
  250.                 Case CD.cd_Level of
  251.                     LEV_FRONT : begin
  252.                         WindowToFront(TheWindow);
  253.                     End;
  254.                     LEV_BACKM : begin
  255.                         WindowToBack(TheWindow);
  256.                     End;
  257.                 End;
  258.             end;
  259.         end;
  260.     end; 
  261.     UnlockPubScreen(NIL, ScreenDef);
  262.     OpenTheWindow := TheWindow; 
  263. End;
  264.  
  265. Procedure CloseTheWindow(VAR w : pWindow);
  266.  
  267. VAR
  268.     m : pMessage;
  269.     
  270. Begin
  271.     If opened then begin
  272.         {Writeln('* CloseTheWindow()');}
  273.  
  274.         m := GetMsg(w^.UserPort);
  275.         while m <> NIL do begin
  276.             ReplyMsg(m);
  277.             m := GetMsg(w^.UserPort);
  278.         End;
  279.         CloseWindow(w);
  280.         FreeGadgets(g[G_NI]);
  281.         FreeVisualInfo(vi);
  282.         w := NIL;
  283.     End;
  284. End;